home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / util / union.sml < prev   
Encoding:
Text File  |  1993-01-27  |  2.2 KB  |  89 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. signature UNIONFIND =
  3.   sig
  4.     exception Union
  5.     val new : (int -> bool) ->
  6.           {union: int * int -> int,
  7.            find : int -> int}
  8.   end
  9.  
  10.  
  11. structure Unionfind : UNIONFIND =
  12.   struct
  13.     exception Union
  14.     fun new (fixed) =
  15.     let open Intmap (* locally rebinding new, of course! *)
  16.         exception UnionM and UnionN
  17.         val m = new(32, UnionM) : int intmap
  18.         fun find x = 
  19.          let val z = find(map m x)
  20.           in add m (x,z); z
  21.          end 
  22.          handle UnionM => x
  23.         fun union (x,y) =
  24.         let val x' = find x and y' = find y
  25.          in if x' <> y'
  26.             then if fixed(x')
  27.              then if fixed(y')
  28.                   then raise Union
  29.                   else (add m (y', x'); x')
  30.              else if fixed(y')
  31.                   then (add m (x', y'); y')
  32.                   else if y' < x'                  
  33.                   then (add m (x', y'); y')
  34.                   else (add m (y', x'); x')
  35.             else x'
  36.         end
  37.      in {union=union, find=find}
  38.     end
  39.   end
  40.  
  41.  
  42. signature SIBLINGS =
  43.   sig
  44.     type 't siblingClass
  45.     val new : (int -> bool) -> '1t siblingClass
  46.      (* assoc(i,x) must be called for any element i before 
  47.         i is used as an argument to union or find or getassoc *)
  48.   end
  49.  
  50.  
  51. structure Siblings : SIBLINGS =
  52.   struct
  53.     type 't siblingClass =
  54.           {assoc : int * 't -> unit,
  55.            union : int * int -> int,
  56.                find : int -> int,
  57.            getassoc : int -> 't list}
  58.     fun new(fixed: int -> bool) : '1t siblingClass =
  59.     let val {union = uni, find = find} = Unionfind.new(fixed)
  60.         exception UnionA
  61.         val a = Intmap.new(32, UnionA) : ('1t * int list) Intmap.intmap
  62.         val add = Intmap.add a
  63.         val map = Intmap.map a
  64.         fun assoc (i,x) = 
  65.         let val (_,l) = map i handle UnionA => (x,nil)
  66.          in add (i,(x,l))
  67.         end
  68.         fun join(i,j) =
  69.           let val (x,l) = map j
  70.            in add (j,(x,i::l)); j
  71.           end
  72.         fun union (i,j) = 
  73.         let val i' = find i and j' = find j
  74.          in if i' = j' then i'
  75.             else let val k = uni(i',j')
  76.               in if k=i' then join(j',k) else join(i',k)
  77.              end
  78.         end
  79.         fun get(i,l) = 
  80.            let fun f (a::b) = get(a,f(b)) | f nil = l
  81.            val (x,r) = map i
  82.         in x::f(r)
  83.            end
  84.         fun getassoc i = get(find i,nil)
  85.      in {assoc=assoc, union=union, find=find, getassoc=getassoc}
  86.     end
  87.   end (* structure Siblings *)
  88.  
  89.